home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
BBS Toolkit
/
BBS Toolkit.iso
/
doors_1
/
gapqbdr.zip
/
DOOR.ZIP
/
DOOR.BAS
< prev
next >
Wrap
BASIC Source File
|
1991-01-12
|
21KB
|
497 lines
'****************************************************************************
'* Copyright (C) 1988-1991 The GAP Development Company
'*
'* All Rights Reserved
'*
'*
'* DOOR.BAS
'*
'* Demonstration program for GAPQBDR
'*
'* To compile : bc /x door;
'* To link : link door,,NUL.MAP,+gapqbdr
'*
'* Program will need access to DOOR.CNF and DOOR.SYS
'*
'****************************************************************************
'***********************************************************************
'* Before doing ANYTHING else, include the following file. *
'***********************************************************************
' $INCLUDE: 'GAPQBDR.BI'
'***********************************************************************
'* Declare any subroutines prior to use *
'***********************************************************************
DECLARE SUB main.menu () ' Our Main Menu handler
DECLARE SUB page.sysop () ' A page sysop routine
DECLARE SUB disp.file () ' display a text file
DECLARE SUB pos.curs () ' cursor positioning routines
DECLARE SUB do.input () ' input demo routines
DECLARE SUB do.output () ' output demo routines
DECLARE SUB era.mess (start%) ' erase from start to end of screen
DECLARE SUB do.scores () ' displays the scoreboard
'***********************************************************************
'* Declare any global variables prior to use *
'***********************************************************************
DIM SHARED anystring AS STRING ' string used for most everything
DIM SHARED menu AS STRING ' for building a menu
DIM SHARED prompt AS STRING ' for the command prompt
DIM SHARED input.str (4,3) AS STRING ' Output string
DIM SHARED output.str (4,3) AS STRING ' Output string
'***********************************************************************
'* Must now read in the error handling code *
'***********************************************************************
' $INCLUDE: 'GAPQBERR.BI'
'***********************************************************************
'* Begin main line code here *
'***********************************************************************
'***********************************************************************
'* Before doing ANYTHING else, initialize the door with the following *
'* two function calls. *
'* Then, if you have any configuration options, line input them in *
'* and close file # 1. *
'***********************************************************************
CALL read.cnf("DOOR.CNF") ' read door configuration file
CALL init.door ' initialize the door
CLOSE #1 ' we dont have any configuration
' options so we will just close
'***********************************************************************
'* Lets now build some menus all at once. *
'* These menus were created with an ANSI editor. This is perhaps the *
'* fastest and easiest way to create menus. It is also faster to *
'* display a menu all at once instead of displaying each line of the *
'* menu one at a time. *
'***********************************************************************
IF c.olor = 1 THEN
menu = "C
╔═══════════════════════════════════════════╗" + CRLF
menu = menu + "C║C
Main MenuC
║" + CRLF
menu = menu + "C╟───────────────────────────────────────────╢" + CRLF
menu = menu + "C║
[
C
]ursor PositioningC[
P
]age Sysop
║" + CRLF
menu = menu + "C║
[
I
]nputC[
S
]how File
║" + CRLF
menu = menu + "C║
[
O
]utputC[
T
]op Players
║" + CRLF
menu = menu + "C║C
[
Q
]uitC
║" + CRLF
menu = menu + "C╚═══════════════════════════════════════════╝" + CRLF + CRLF
ELSE
menu = " ╔═══════════════════════════════════════════╗" + CRLF
menu = menu + " ║ Main Menu ║" + CRLF
menu = menu + " ╟───────────────────────────────────────────╢" + CRLF
menu = menu + " ║ [C]ursor Positioning [P]age Sysop ║" + CRLF
menu = menu + " ║ [I]nput [S]how File ║" + CRLF
menu = menu + " ║ [O]utput [T]op Players ║" + CRLF
menu = menu + " ║ [Q]uit ║" + CRLF
menu = menu + " ╚═══════════════════════════════════════════╝" + CRLF + CRLF
END IF
input.str[1,1] = "GET.STRING is the main input routine. It takes 1 parameter which" + CRLF
input.str[1,1] = input.str[1,1] + "is the string in which input is to be stored. The length of the" + CRLF
input.str[1,1] = input.str[1,1] + "string determines the number of characters allowed to be entered." + CRLF
input.str[1,1] = input.str[1,1] + "GET.STRING takes care of validating keystrokes and keyboard" + CRLF
input.str[1,1] = input.str[1,1] + "timeout." + CRLF
input.str[1,2] = " response$ = " + CHR$(34) + " " + CHR$(34) + CRLF
input.str[1,2] = input.str[1,2] + " CALL get.string(response$)" + CRLF
input.str[1,3] = " Will input a string with a maximum length of 4 characters."
input.str[2,1] = "GETAKEY% is the main, single character input routine. It is called" + CRLF
input.str[2,1] = input.str[2,1] + "internally by GET.STRING and other GAPQBDR functions. It does not" + CRLF
input.str[2,1] = input.str[2,1] + "validate keystrokes nor does it check for keyboard timeout. GETAKEY%" + CRLF
input.str[2,1] = input.str[2,1] + "returns 0 if there are no characters waiting. Otherwise, it returns" + CRLF
input.str[2,1] = input.str[2,1] + "the ASCII code for the character." + CRLF
input.str[2,2] = " DIM r AS INTEGER" + CRLF
input.str[2,2] = input.str[2,2] + " r = getakey%" + CRLF
input.str[2,3] = " If key waiting, will return the ASCII code for the character."
input.str[3,1] = "CKEYPRESS% is used to determine if a character is waiting to be input." + CRLF
input.str[3,1] = input.str[3,1] + "It is used mainly in loops that must poll the keyboard and the comm" + CRLF
input.str[3,1] = input.str[3,1] + "port. It returns 0 if no key is waiting. Otherwise it returns the ASCII" + CRLF
input.str[3,1] = input.str[3,1] + "code for the character without removing the character from the keyboard" + CRLF
input.str[3,1] = input.str[3,1] + "buffer or the communications receive buffer." + CRLF
input.str[3,2] = " IF ckeypress% <> 0 THEN" + CRLF
input.str[3,2] = input.str[3,2] + " ' execute if character is waiting" + CRLF
input.str[3,3] = " If characters waiting to be input, will execute body of THEN statement."
input.str[4,1] = "GETKEYC% is used to retrieve keystrokes from the local keyboard. It isn't" + CRLF
input.str[4,1] = input.str[4,1] + "of much use to the GAPQBDR programmer since it checks ONLY the keyboard" + CRLF
input.str[4,1] = input.str[4,1] + "for characters and knows nothing about communications ports, keyboard" + CRLF
input.str[4,1] = input.str[4,1] + "timeout, or valid keystrokes. This routine WAITS for a keystroke. It" + CRLF
input.str[4,1] = input.str[4,1] + "returns the ASCII code and the keyboard scan code for the key pressed." + CRLF
input.str[4,2] = " DIM r AS INTEGER" + CRLF
input.str[4,2] = input.str[4,2] + " r = getkeyc%" + CRLF
input.str[4,3] = " Calls the BIOS and waits for a keypress."
output.str[1,1] = "SHOW.MESS is the main output routine. It takes 3 parameters:" + CRLF
output.str[1,1] = output.str[1,1] + "The string to output, a YES/NO flag to ring the bell, and a" + CRLF
output.str[1,1] = output.str[1,1] + "YES/NO flag to send a CR/LF after the string. The sysop's" + CRLF
output.str[1,1] = output.str[1,1] + "bell will ring only if the caller alarm is turned on. This" + CRLF
output.str[1,1] = output.str[1,1] + "text is being displayed with a single SHOW.MESS call." + CRLF
output.str[1,2] = " CALL show.mess(" + CHR$(34) + "This is an output string" + CHR$(34) + ",NO,YES)" + CRLF + CRLF
output.str[1,3] = " Will display the string on the local and remote consoles."
output.str[2,1] = "PUTACHAR is the main single character output routine. It filters" + CRLF
output.str[2,1] = output.str[2,1] + "control characters and handles screen full situations. It should" + CRLF
output.str[2,1] = output.str[2,1] + "be used when single character output is desired since it" + CRLF
output.str[2,1] = output.str[2,1] + "automatically sends the characters to the communications port" + CRLF
output.str[2,1] = output.str[2,1] + "if a remote caller is online." + CRLF
output.str[2,2] = " CALL putachar('C')" + CRLF + CRLF
output.str[2,3] = " Will send the character 'C' to the local and remote consoles."
output.str[3,1] = "SHOW.FILE is the routine that allows you to display text files." + CRLF
output.str[3,1] = output.str[3,1] + "It takes a single parameter, the full path and name of the" + CRLF
output.str[3,1] = output.str[3,1] + "file to display. Color files (those ending in 'G') are" + CRLF
output.str[3,1] = output.str[3,1] + "automatically displayed if the caller is in color mode and" + CRLF
output.str[3,1] = output.str[3,1] + "the file exists." + CRLF
output.str[3,2] = " CALL show.file(" + CHR$(34) + "C:\GAP\GEN\WELCOME" + CHR$(34) + ")" + CRLF + CRLF
output.str[3,3] = " Will show the Welcome file in the GAP\GEN directory."
output.str[4,1] = "PUTKEY is an internal routine used by Sysop Chat. It provides" + CRLF
output.str[4,1] = output.str[4,1] + "for full word wrapping. It is an undocumented function" + CRLF
output.str[4,1] = output.str[4,1] + "but available for your use if you have a need for its" + CRLF
output.str[4,1] = output.str[4,1] + "word wrapping abilities." + CRLF + CRLF
output.str[4,2] = " CALL putkey('C')" + CRLF + CRLF
output.str[4,3] = " Will send the character 'C' and wrap the word if necessary."
CALL main.menu ' main input routine
CALL clear.scr ' clear the screen
CALL show.file("COMPARE") ' show log off file
CALL pause ' wait for a keypress
CALL clear.scr ' tidy up the screen
'***********************************************************************
' The only proper way to exit the door is via the subroutine LEAVE. *
' Leave performs various functions that insure the computer is left in *
' the state is was prior to running the door program. If leave is not *
' called prior to exiting the door, communications interrupts will *
' remain active and the computer will most surely hang as soon as *
' another program is loaded. *
'***********************************************************************
CALL leave ' thats all
END
SUB main.menu
DIM response AS STRING ' for getting responses
CALL time.left
DO
'***********************************************************************
' Lets now build our command prompt that will be used by other *
' routines. Notice that we will show the caller how much time he or *
' she has left. We can do this because GAP provides this information *
' to door programs. The amount of time (in minutes) a caller has left *
' is stored in the timeleft variable. *
' Our prompt will vary according to the color status of the caller. *
'***********************************************************************
IF c.olor = 1 THEN
prompt = YELLOW + "[" + BRED + LTRIM$(STR$(timeleft)) + " mins" + YELLOW + "] Main Command : "
ELSE
prompt = "[" + LTRIM$(STR$(timeleft)) + " mins] Main Command : "
END IF
CALL clear.scr ' first clear the screen
CALL show.mess(menu, NO, YES) ' show the menu
CALL show.mess(prompt, NO, NO) ' show the prompt
response = " " ' initialize response
CALL get.string(response) ' get user input
SELECT CASE response
CASE "C"
CALL pos.curs
CASE "I"
CALL do.input
CASE "O"
CALL do.output
CASE "P"
CALL page.sysop
CASE "S"
CALL disp.file
CASE "T"
CALL do.scores
CASE ELSE
IF response <> "Q" THEN
CALL nl(2)
CALL ansi(BRED)
CALL show.mess("Please Enter A Valid Response!", YES, YES)
CALL nl(1)
CALL pause
END IF
END SELECT
LOOP UNTIL response = "Q"
END SUB
SUB page.sysop
'***********************************************************************
'* We are going to override the sysop's page bell flag so we can *
'* hear the bell. This is not a good thing to do as it will tend *
'* to anger the sysop if a door program does not honor his BBS *
'* settings. Sorry sysop. We'll put the bell flag back the way it *
'* was when we are finished. *
'***********************************************************************
DIM oldbell AS INTEGER ' so we dont make sysop mad
oldbell = bell ' keep track of old bell setting
bell = 1 ' turn sysop's page bell on
CALL pagesysop ' now page the sysop
bell = oldbell ' restore old bell setting
END SUB
SUB disp.file
'***********************************************************************
'* The show.file() routine makes certain assumptions about the file *
'* name being passed to it. It assumes that you are calling it with *
'* a path and file name for a file that you know is or should be *
'* present. Show.file() will attempt to find the file, but if it *
'* cannot, it simply returns (no error code). *
'***********************************************************************
CALL clear.scr ' first clear the screen
IF a.ccess%("WELCOME") <> 0 THEN ' does file exist?
CALL nl(1)
CALL ansi(BRED) ' no, tell them in RED!
CALL show.mess("File 'WELCOME' Not Found!", YES, YES)
CALL nl(1)
CALL pause
EXIT SUB
END IF
CALL ansi(YELLOW) ' reset default color
CALL show.file("WELCOME") ' now show the file.
CALL pause ' wait for key press
END SUB
SUB pos.curs
DIM r AS INTEGER
DIM r.ow AS INTEGER
DIM c.ol AS INTEGER
CALL clear.scr ' first clear the screen
CALL atsay(3,3,CHR$(201)) ' top left corner
FOR r = 4 TO 77 ' top edge
CALL atsay(3,r,CHR$(205))
NEXT r
CALL atsay(3,78,CHR$(187)) ' top right corner
FOR r = 4 TO 16 ' right edge
CALL atsay(r,78,CHR$(186))
NEXT r
CALL atsay(17,78,CHR$(188)) ' bottom right corner
FOR r = 77 TO 4 STEP -1 ' bottom edge
CALL atsay(17,r,CHR$(205))
NEXT r
CALL atsay(17,3,CHR$(200)) ' bottom left corner
FOR r = 16 TO 4 STEP -1 ' left edge
CALL atsay(r,3,CHR$(186))
NEXT r
CALL ansi(BGREEN)
CALL atsay(2,24,"Fast Screen Drawing Using ATSAY")
CALL atsay(18,39,"
[
8
]")
CALL atsay(19,25,"
Cursor
[
4
] [
6
]
Movement")
CALL atsay(20,39,"
[
2
]")
CALL atsay(22,18,"Move Cursor, Type A Character. [
Esc
] To Quit.")
r.ow = 10
c.ol = 40
CALL at(r.ow,c.ol)
DO
temptime = get.time& ' get current time
DO
r = getakey% ' get a key press
IF r <> 0 THEN ' if there was a key press
EXIT DO ' then process key
END IF
CALL elap.time ' see if no keyboard activity
LOOP
SELECT CASE r
CASE 27 ' ESC pressed?
EXIT DO
CASE 50 ' 2 - Down Arrow
r.ow = r.ow +1
if r.ow > 16 then r.ow = 4
CALL at(r.ow,c.ol)
CASE 52 ' 4 - Left Arrow
c.ol = c.ol -1
if c.ol < 4 then c.ol = 77
CALL at(r.ow,c.ol)
CASE 54 ' 6 - Right Arrow
c.ol = c.ol +1
if c.ol > 77 then c.ol = 4
CALL at(r.ow,c.ol)
CASE 56 ' 8 - Up Arrow
r.ow = r.ow -1
if r.ow < 4 then r.ow = 16
CALL at(r.ow,c.ol)
CASE ELSE
IF r > 31 AND r < 127 THEN
CALL atsay(r.ow,c.ol,CHR$(r)) ' show the character
CALL at(r.ow,c.ol) ' move cursor back
END IF
END SELECT
LOOP UNTIL r = 27
CALL at(22,1)
CALL eraeol
CALL pause
END SUB
SUB do.input
DIM r AS INTEGER
CALL clear.scr ' first clear the screen
CALL ansi(BGREEN)
CALL show.mess("Input Routines",NO,YES)
CALL show.mess("==============",NO,YES)
CALL nl(1)
CALL ansi(YELLOW)
CALL show.mess("GET.STRING - High Level",NO,YES)
CALL show.mess("GETAKEY% - Low Level",NO,YES)
CALL show.mess("CKEYPRESS% - Low Level",NO,YES)
CALL show.mess("GETKEYC% - Low Level",NO,YES)
call nl(1)
FOR r = 1 to 4
CALL ansi(BCYAN)
CALL show.mess(input.str[r,1],NO,YES)
CALL ansi(BGREEN)
CALL show.mess(" Example",NO,YES)
CALL show.mess(" -------",NO,YES)
CALL nl(1)
CALL ansi(BCYAN)
CALL show.mess(input.str[r,2],NO,YES)
CALL ansi(BGREEN)
CALL show.mess(input.str[r,3],NO,YES)
CALL nl(1)
CALL pause
CALL era.mess(9)
CALL at(9,1)
NEXT r
END SUB
SUB do.output
DIM r AS INTEGER
CALL clear.scr ' first clear the screen
CALL ansi(BGREEN)
CALL show.mess("Output Routines",NO,YES)
CALL show.mess("===============",NO,YES)
CALL nl(1)
CALL ansi(YELLOW)
CALL show.mess("SHOW.MESS - High Level",NO,YES)
CALL show.mess("PUTACHAR - High Level",NO,YES)
CALL show.mess("SHOW.FILE - High Level",NO,YES)
CALL show.mess("PUTKEY - Low Level",NO,YES)
call nl(1)
FOR r = 1 to 4
CALL ansi(BCYAN)
CALL show.mess(output.str[r,1],NO,YES)
CALL ansi(BGREEN)
CALL show.mess(" Example",NO,YES)
CALL show.mess(" -------",NO,YES)
CALL nl(1)
CALL ansi(BCYAN)
CALL show.mess(output.str[r,2],NO,YES)
CALL ansi(BGREEN)
CALL show.mess(output.str[r,3],NO,YES)
CALL nl(1)
CALL pause
CALL era.mess(9)
CALL at(9,1)
NEXT r
END SUB
SUB era.mess (start%)
' Subroutine to erase from start position to end of screen
DIM r AS INTEGER
FOR r = start% to 23
CALL at(r,1)
CALL eraeol
NEXT r
END SUB
SUB do.scores
IF read.score% ("DOOR.DAT","Example Door High Scores") = 1 THEN
CALL ansi(BRED)
CALL show.mess("File DOOR.DAT is Missing!",NO,YES)
CALL nl(1)
CALL pause
END IF
END SUB